home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / demos / 108 / modula / clipboar.mod < prev    next >
Encoding:
Modula Implementation  |  1987-02-20  |  4.0 KB  |  145 lines
  1. IMPLEMENTATION MODULE ClipBoard;
  2.  
  3. (* Jefferson Software Copyright 1986 *)
  4.  
  5. (* Jefferson Software      *)
  6. (* 12416 N 28th Dr #18-236 *)
  7. (* Phoenix,  AZ 85029-2434 *)
  8. (* (602)243-3106           *)
  9.  
  10. (* Phase BBS (602)849-1287 (up to 2400 baud) has source *)
  11. (* and answers about Jefferson Software Modula in Sig 8 *)
  12.  
  13. (* Compuserve ID 73637, 1245 *)
  14.  
  15. (* Permission to use this source is given to all who   *)
  16. (* agree to include Jefferson Software's copyright     *)
  17. (* notice, address, and phone number in all copies of  *)
  18. (* this source or source derived from this source.     *)
  19. (* Please send any changes, updates or bugs to us at   *)
  20. (* Jefferson Software. If you have code you want to    *)
  21. (* share with us all, send it and any documentation to *)
  22. (* us. Please tell us if you want your name included.  *)
  23.  
  24. FROM SYSTEM IMPORT ADDRESS, ADR, REG, SETREG, INLINE, SHORT, LONG;
  25.  
  26. CONST D0 = 0;
  27.   A7 = 15;
  28.  
  29. VAR
  30.   a7 : LONGINT;
  31.   clipTemp : LONGINT;
  32.   magicnr : LONGINT;
  33.  
  34. PROCEDURE trapStatus;
  35. BEGIN
  36.   INLINE(91C8H); (* suba.l a0,a0 *)
  37.   INLINE(2068H); INLINE(00A8H); (* movea.l a8(a0),a0 *)
  38.   INLINE(2028H); INLINE(0002H); (* move.l 2(a0),d0 *)
  39.   clipTemp := VAL(LONGINT,REG(D0));
  40. END trapStatus; 
  41.  
  42. PROCEDURE InfoClip(VAR info : PClipInfo) : INTEGER;
  43. TYPE
  44.   proc = PROCEDURE();
  45. VAR
  46.   sup : proc;
  47. BEGIN
  48.   (* Supexec(trapStatus) (* XBIOS *) *)
  49.   a7 := REG(A7); (* save stack pointer *)
  50.   sup := trapStatus;
  51.   SETREG(D0,sup);
  52.   INLINE(2F00H); (* move.l d0,-(sp) *)
  53.   SETREG(D0,38);
  54.   INLINE(3F00H); (* move.w d0,-(sp) *)
  55.   INLINE(4E4EH); (* trap #14 *)
  56.   SETREG(A7,a7); (* pop stack *)
  57.  
  58.   magicnr := LONG(0FDB9H, 7531H);
  59.   IF clipTemp # magicnr THEN RETURN 0 END;
  60.  
  61.   a7 := REG(A7); (* save stack pointer *)
  62.   SETREG(D0,ADR(info));
  63.   INLINE(2F00H); (* move.l d0,-(sp) *)
  64.   SETREG(D0,0);
  65.   INLINE(3F00H); (* move.w d0,-(sp) *)
  66.   INLINE(4E4AH); (* trap 10 *)
  67.   SETREG(A7,a7); (* pop stack *)
  68.   RETURN SHORT(VAL(LONGINT,REG(D0)));
  69. END InfoClip;
  70.  
  71. PROCEDURE UnloadClip() : INTEGER;
  72. VAR i : INTEGER; (* dummy to hold Clip return *)
  73. BEGIN
  74.   a7 := REG(A7); (* save stack pointer *)
  75.   SETREG(D0,1);
  76.   INLINE(3F00H); (* move.w d0,-(sp) *)
  77.   INLINE(4E4AH); (* trap 10 *)
  78.   SETREG(A7,a7); (* pop stack *)
  79.   RETURN SHORT(VAL(LONGINT,REG(D0)));
  80. END UnloadClip;
  81.  
  82. PROCEDURE LoadClip() : INTEGER;
  83. BEGIN
  84.   a7 := REG(A7); (* save stack pointer *)
  85.   SETREG(D0,2);
  86.   INLINE(3F00H); (* move.w d0,-(sp) *)
  87.   INLINE(4E4AH); (* trap 10 *)
  88.   SETREG(A7,a7); (* pop stack *)
  89.   RETURN SHORT(VAL(LONGINT,REG(D0)));
  90. END LoadClip;
  91.  
  92. PROCEDURE ZeroClip;
  93. VAR i : INTEGER; (* dummy to hold Clip return *)
  94. BEGIN
  95.   a7 := REG(A7); (* save stack pointer *)
  96.   SETREG(D0,3);
  97.   INLINE(3F00H); (* move.w d0,-(sp) *)
  98.   INLINE(4E4AH); (* trap 10 *)
  99.   SETREG(A7,a7); (* pop stack *)
  100. END ZeroClip;
  101.  
  102. PROCEDURE PutClip(length : LONGINT; source : ADDRESS) : INTEGER;
  103. BEGIN
  104.   a7 := REG(A7); (* save stack pointer *)
  105.   SETREG(D0,length);
  106.   INLINE(2F00H); (* move.l d0,-(sp) *)
  107.   SETREG(D0,source);
  108.   INLINE(2F00H); (* move.l d0,-(sp) *)
  109.   SETREG(D0,4);
  110.   INLINE(3F00H); (* move.w d0,-(sp) *)
  111.   INLINE(4E4AH); (* trap 10 *)
  112.   SETREG(A7,a7); (* pop stack *)
  113.   RETURN SHORT(VAL(LONGINT,REG(D0)));
  114. END PutClip;
  115.  
  116. PROCEDURE GetClip(length : ADDRESS;
  117.                   source : ADDRESS;
  118.                   loadflag : CHAR) : INTEGER;
  119. BEGIN
  120.   a7 := REG(A7); (* save stack pointer *)
  121.   SETREG(D0,loadflag);
  122.   INLINE(3F00H); (* move.w d0,-(sp) *)
  123.   SETREG(D0,source);
  124.   INLINE(2F00H); (* move.l d0,-(sp) *)
  125.   SETREG(D0,length);
  126.   INLINE(2F00H); (* move.l d0,-(sp) *)
  127.   SETREG(D0,5);
  128.   INLINE(3F00H); (* move.w d0,-(sp) *)
  129.   INLINE(4E4AH); (* trap 10 *)
  130.   SETREG(A7,a7); (* pop stack *)
  131.   RETURN SHORT(VAL(LONGINT,REG(D0)));
  132. END GetClip;
  133.  
  134. PROCEDURE InitClip;
  135. VAR i : INTEGER; (* dummy to hold Clip return *)
  136. BEGIN
  137.   a7 := REG(A7); (* save stack pointer *)
  138.   SETREG(D0,6);
  139.   INLINE(3F00H); (* move.w d0,-(sp) *)
  140.   INLINE(4E4AH); (* trap 10 *)
  141.   SETREG(A7,a7); (* pop stack *)
  142. END InitClip;
  143.  
  144. END ClipBoard.
  145.